home *** CD-ROM | disk | FTP | other *** search
/ Gold Medal Software 1 / Gold Medal Software Volume 1 (Gold Medal) (1994).iso / prog / tpwprog6.arj / MODELESS.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-07-02  |  4.5 KB  |  174 lines
  1. { modeless.pas -- Modeless dialog test. (Not in book.) }
  2.  
  3. program List;
  4.  
  5. {$R modeless.res}
  6.  
  7. uses WinTypes, WinProcs, WObjects, Strings;
  8.  
  9. const
  10.  
  11.   id_Menu    = 100;  { Menu resource ID }
  12.   cm_Dialog  = 101;  { Dialog-command ID }
  13.   id_Dialog  = 200;  { Dialog resource ID }
  14.  
  15.   id_Add     = 101;  { Dialog control ID values }
  16.   id_Delete  = 102;
  17.   id_Input   = 103;
  18.   id_Listbox = 104;
  19.  
  20.   inputLen   = 40;   { Maximum length of input edit control }
  21.  
  22. type
  23.  
  24.   PListDialog = ^ListDialog;
  25.   ListDialog = object(TDialog)
  26.     SelPointer: PChar;
  27.     constructor Init(AParent: PWindowsObject; AName: PChar; P: PChar);
  28.     destructor Done; virtual;
  29.     procedure SetupWindow; virtual;
  30.     procedure IDAdd(var Msg: TMessage);
  31.       virtual id_First + id_Add;
  32.     procedure IDDelete(var Msg: TMessage);
  33.       virtual id_First + id_Delete;
  34.     procedure Ok(var Msg: TMessage);
  35.       virtual id_First + id_Ok;
  36.   end;
  37.  
  38.   ListApplication = object(TApplication)
  39.     procedure InitMainWindow; virtual;
  40.   end;
  41.  
  42.   PListWindow = ^ListWindow;
  43.   ListWindow = object(TWindow)
  44.     Selection: array[0 .. inputLen] of Char;
  45.     constructor Init(AParent: PWindowsObject; ATitle: PChar);
  46.     procedure CMDialog(var Msg: TMessage);
  47.       virtual cm_First + cm_Dialog;
  48.   end;
  49.  
  50. {- Add to list box identified by CrtlID in dialog window with the
  51. handle HDlg a new string addressed by P }
  52. procedure SetList(HDlg: HWnd; CtrlID: Word; P: PChar);
  53. begin
  54.   SendDlgItemMessage(HDlg, CtrlID, lb_AddString, 0, LongInt(P))
  55. end;
  56.  
  57.  
  58. {----- ListDialog methods -----}
  59.  
  60. constructor ListDialog.Init(AParent: PWindowsObject; AName: PChar;
  61.   P: PChar);
  62. begin
  63.   TDialog.Init(AParent, AName);
  64.   (*Attr.Style = ws_Popup or ws_OverlappedWindow or ws_Visible; *)
  65.   SelPointer := P  { Save pointer to caller's char array }
  66. end;
  67.  
  68. destructor ListDialog.Done;
  69. begin
  70.   MessageBeep(0);
  71.   TDialog.Done
  72. end;
  73.  
  74. procedure ListDialog.SetupWindow;
  75. begin
  76.   TDialog.SetupWindow;
  77.  
  78. {- Standard Windows-message technique }
  79. (* SendDlgItemMessage(HWindow, id_Input, em_LimitText, inputLen, 0); *)
  80.  
  81. {- Equivalent TDialog method call }
  82.   SendDlgItemMsg(id_Input, em_LimitText, inputLen, 0);
  83.  
  84.   SetList(HWindow, id_Listbox, 'Apples');
  85.   SetList(HWindow, id_Listbox, 'Peaches');
  86.   SetList(HWindow, id_Listbox, 'Pumpkin');
  87.   SetList(HWindow, id_Listbox, 'Pie');
  88. end;
  89.  
  90. {- Respond to Add button--Add text to list box }
  91. procedure ListDialog.IDAdd(var Msg: TMessage);
  92. var
  93.   Buffer: array[0 .. inputLen] of Char;
  94. begin
  95.   Buffer[0] := Chr(0);
  96.   SendDlgItemMessage(HWindow, id_Input, wm_GetText, inputLen,
  97.     LongInt(@Buffer));
  98.   if StrLen(Buffer) > 0 then
  99.   begin
  100.     SetList(HWindow, id_Listbox, Buffer);
  101.     SendDlgItemMessage(HWindow, id_Input, em_SetSel, 0,
  102.       MakeLong(32767, 0))
  103.   end
  104. end;
  105.  
  106. {- Respond to Delete button--Delete selected list item }
  107. procedure ListDialog.IDDelete(var Msg: TMessage);
  108. var
  109.   Item: Word;   { Selected listbox-item index }
  110. begin
  111.   Item := SendDlgItemMessage(HWindow, id_Listbox, lb_GetCurSel, 0, 0);
  112.   if Item <> 0 then
  113.     SendDlgItemMessage(HWindow, id_Listbox, lb_DeleteString, Item, 0)
  114. end;
  115.  
  116. {- Respond to Ok button; Pass selected item back to caller. }
  117. procedure ListDialog.Ok(var Msg: TMessage);
  118. var
  119.   Item: Word;   { Selected listbox-item index }
  120. begin
  121.   Item := SendDlgItemMessage(HWindow, id_Listbox, lb_GetCurSel, 0, 0);
  122.   if Item <> lb_Err then
  123.     SendDlgItemMessage(HWindow, id_Listbox, lb_GetText, Item,
  124.       LongInt(SelPointer))
  125.   else
  126.     SelPointer[0] := Chr(0);  { No selection }
  127.   TDialog.Ok(Msg);
  128. end;
  129.  
  130.  
  131. {----- ListApplication methods -----}
  132.  
  133. {- Initialize ListApplication object's window }
  134. procedure ListApplication.InitMainWindow;
  135. begin
  136.   MainWindow := New(PListWindow, Init(nil, 'List'))
  137. end;
  138.  
  139.  
  140. {----- ListWindow methods -----}
  141.  
  142. {- Construct ListWindow object }
  143. constructor ListWindow.Init(AParent: PWindowsObject; ATitle: PChar);
  144. begin
  145.   TWindow.Init(AParent, ATitle);
  146.   Attr.Menu := LoadMenu(HInstance, PChar(id_Menu));
  147. end;
  148.  
  149. {- Execute Menu:Dialog command }
  150. procedure ListWindow.CMDialog(var Msg: TMessage);
  151. var
  152.   D: PListDialog;
  153. begin
  154.   D := New(PListDialog, Init(@Self, PChar(id_Dialog), Selection));
  155.   D^.EnableAutoCreate;
  156.   Application^.MakeWindow(D);
  157. end;
  158.  
  159. var
  160.  
  161.   ListApp: ListApplication;
  162.  
  163. begin
  164.   ListApp.Init('ListApp');
  165.   ListApp.Run;
  166.   ListApp.Done
  167. end.
  168.  
  169.  
  170. {--------------------------------------------------------------
  171.   Copyright (c) 1991 by Tom Swan. All rights reserved.
  172.   Revision 1.00    Date: 3/20/1991
  173. ---------------------------------------------------------------}
  174.